home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / graphics / amicad / arexx_english / addrefs.amicad next >
Text File  |  1999-12-06  |  6KB  |  256 lines
  1. /* This script adds references to the selected parts or to all the specified components
  2.    $VER: AddRefs.AmiCAD 1.03e (© R.Florac, 22 mai 1999) */
  3.  
  4. options results
  5.  
  6. signal on error
  7. signal on syntax
  8.  
  9. 'SELECT("Component type to reference"+CHR(10)+"Resistances"+CHR(10)+"Capacitors"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Integrated circuits"+CHR(10)+"All the components"+CHR(10)+"Specific Components")'
  10. choix=result
  11. select
  12.     when choix=1 then do
  13.     reference='R'
  14.     type="#?Resist#?"
  15.     end
  16.     when choix=2 then do
  17.     reference='C'
  18.     type="#?Capacit#?"
  19.     end
  20.     when choix=3 then do
  21.     reference='D'
  22.     type="#?Diod#?"
  23.     end
  24.     when choix=4 then do
  25.     reference='Q'
  26.     type="#?Transist#?"
  27.     end
  28.     when choix=5 then do
  29.     reference="IC"
  30.     type=1
  31.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'
  32.     end
  33.     when choix=6 then do
  34.     'SAVEALL(-1)'
  35.     call marquer_composant('R',"Res#?",-1)
  36.     call marquer_composant('C',"Cond#?",-1)
  37.     call marquer_composant('D',"Diod#?",-1)
  38.     call marquer_composant('Q',"Transist#?",-1)
  39.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'       /*  v1.02 */
  40.     call marquer_composant('CI',1,-1)
  41.     exit
  42.     end
  43.     when choix=7 then do
  44.     'ASK("What is the name of"+CHR(10)+"the components to reference?"+CHR(10)+"You can use the generic"+CHR(10)+"chars (#?) for a"+CHR(10)+"larger selection")'
  45.     type=result
  46.     if type='' then exit
  47.     'ASK("What is the reference"+CHR(10)+"for these components?")'
  48.     reference=result
  49.     if reference='' then exit
  50.     end
  51.     otherwise exit
  52. end
  53. 'N=FIRSTSEL'; obj=result
  54. if obj>0 then do
  55.     'REQUEST("Do you want to reference"+CHR(10)+"only the selected"+CHR(10)+"components?"+CHR(10)+"If you choose NO the"+CHR(10)+"operation will be done"+CHR(10)+"for every component"+CHR(10)+"on the document.")'
  56.     choix=result
  57. end
  58. else choix=0
  59. 'SAVEALL(-1)'
  60. call marquer_composant(reference,type,choix)
  61. exit
  62.  
  63. marquer_composant: procedure
  64.     parse arg reference,type,selection
  65.     if selection<=0 then do
  66.     /* Annulation du marquage éventuel */
  67.     'UNMARK(-1)'
  68.     /* Marquage et comptage des éléments à référencer */
  69.     if type=1 then do
  70.         'SECURITY(OBJECTS(-1)+10):I=0:N=1:WHILE(N<=OBJECTS(-1),IF(TYPE(N)==1,IF(GETDEVS(PARTNAME(N))>0,MARK(N):I=I+1,0),0),N=N+1):I'
  71.     end
  72.     else 'SECURITY(OBJECTS(-1)+10):N=0:I=0:WHILE(I=IF(I+1<=OBJECTS(-1),FINDPART(I+1,"'type'"),0),MARK(I):N=N+1):N'
  73.     n=result
  74.     end
  75.     else do
  76.     /* Comptage des éléments déjà marqués */
  77.     if type=1 then do
  78.         'SECURITY(OBJECTS(-1)+10):I=0:N=FIRSTSEL:WHILE(N,IF(TYPE(N)==1,I=I+1,UNMARK(N)),N=NEXTSEL(N)):I'
  79.     end
  80.     else 'SECURITY(OBJECTS(-1)+10):I=0:WHILE(N,N=FINDPART(N,"'type'"):IF(N>0,IF(TEST(N)>0,I=I+1,0):N=N+1,0)):I'
  81.     n=result
  82.     end
  83.     if n=0 then do
  84.     if selection>=0 then do
  85.         'MESSAGE("There is no"+CHR(10)+"object of this type")'
  86.         exit
  87.     end
  88.     else return
  89.     end
  90.  
  91.     /* Test des références, ajout éventuel */
  92.     call test_references(type,reference)
  93.     objet=selection_objet(1,type)
  94.     do i=1 to n
  95.     'GETREF('objet')'; ref=result
  96.     if ref=0 then call ajouter_reference(objet,reference)
  97.     else do
  98.         'READTEXT('ref')'
  99.         j=right(result,length(result)-length(reference))
  100.         if j~="" then do
  101.         ref.i=1
  102.         end
  103.     end
  104.     if i<n then objet=selection_objet(objet+1,type)
  105.     end
  106.  
  107.     /* Écriture des références */
  108.     objet=selection_objet(1,type)
  109.     numref=0
  110.     do i=1 to n
  111.     if ref.i~=1 then do
  112.         numref=numref+1
  113.         do while val.numref=1
  114.         numref=numref+1
  115.         end
  116.         'R=GETREF('objet'):SETTEXT(R,READTEXT(R)+"'numref'"):GETDEVS(PARTNAME('objet'))'
  117.         if result>1 then do
  118.         'SETTEXT(R,READTEXT(R)+CHR(READDEV('objet')+64))'
  119.         end
  120.     end
  121.     if i<n then do
  122.         objet=selection_objet(objet+1,type)
  123.     end
  124.     end
  125.     return
  126. end
  127.  
  128. ajouter_reference: procedure
  129.     parse arg obj,reference
  130.     'LINKREF('obj',WRITE("'reference'",COL('obj')+WIDTH('obj')+5,LINE('obj')+HEIGHT('obj')/2))'
  131.     return
  132. end
  133.  
  134. selection_objet: procedure
  135.     parse arg obj,type
  136.     if type=1 then do
  137.     'R='obj':WHILE(TEST_CIRCUIT(R)<1,R=NEXTSEL(R)):R'
  138.     end
  139.     else do
  140.     'R=FINDPART('obj',"'type'"):WHILE(TEST(R)==0,R=FINDPART(R+1,"'type'")):R'
  141.     end
  142.     return result
  143. end
  144.  
  145. /* Procédure testant et marquant les références déjà existantes */
  146. test_references: procedure expose val.
  147.     parse arg type,reference
  148.     obj=1
  149.     'OBJECTS(-1)';objets=result
  150.     do while obj<=objets
  151.     if type=1 then do
  152.         'RO='obj':WHILE(IF(RO>0,TYPE(RO)<>1,0),RO=NEXTSEL(RO)):RO'; obj=result
  153.     end
  154.     else do
  155.         'FINDPART('obj',"'type'")'; obj=result
  156.     end
  157.     if obj=0 then leave
  158.     'GETREF('obj')'; ref=result
  159.     if ref>0 then do
  160.         'READTEXT('ref')'
  161.         j=right(result,length(result)-length(reference))
  162.         if j~="" then do
  163.         'VAL("'j'")'; j=result
  164.         val.j=1
  165.         end
  166.     end
  167.     obj=obj+1
  168.     end
  169.     return
  170. end
  171.  
  172.  
  173. 'SAVEALL(-1)'
  174. call test_references(type,reference)
  175. objet=selection_objet(1,type)
  176. do i=1 to n
  177.     'GETREF('objet')'; ref=result
  178.     if ref=0 then call ajouter_reference(objet,reference)
  179.     else do
  180.     'READTEXT('ref')'
  181.     j=right(result,length(result)-length(reference))
  182.     if j~="" then do
  183.         ref.i=1
  184.     end
  185.     end
  186.     if i<n then objet=selection_objet(objet+1,type)
  187. end
  188.  
  189. objet=selection_objet(1,type)
  190. numref=0
  191. do i=1 to n
  192.     if ref.i~=1 then do
  193.     numref=numref+1
  194.     do while val.numref=1
  195.         numref=numref+1
  196.     end
  197.     'R=GETREF('objet'):SETTEXT(R,READTEXT(R)+"'numref'")'
  198.     end
  199.     if i<n then do
  200.     objet=selection_objet(objet+1,type)
  201.     end
  202. end
  203.  
  204. exit
  205.  
  206. ajouter_reference: procedure
  207.     parse arg obj,reference
  208.     'LINKREF('obj',WRITE("'reference'",COL('obj')+WIDTH('obj')+5,LINE('obj')+HEIGHT('obj')/2))'
  209.     return
  210. end
  211.  
  212. selection_objet: procedure
  213.     parse arg obj,type
  214.     if type=1 then do
  215.     'R='obj':WHILE(TEST_CIRCUIT(R)==0,R=NEXTSEL(R)):R'
  216.     end
  217.     else do
  218.     'R=FINDPART('obj',"'type'"):WHILE(TEST(R)==0,R=FINDPART(R+1,"'type'")):R'
  219.     end
  220.     return result
  221. end
  222.  
  223. test_references: procedure expose val.
  224.     parse arg type,reference
  225.     obj=1
  226.     'OBJECTS(-1)';objets=result
  227.     do while obj<=objets
  228.     if type=1 then do
  229.         'RO='obj':WHILE(IF(RO>0,TYPE(RO)<>1,0),RO=NEXTSEL(RO)):RO'; obj=result
  230.     end
  231.     else do
  232.         'FINDPART('obj',"'type'")'; obj=result
  233.     end
  234.     if obj=0 then leave
  235.     'GETREF('obj')'; ref=result
  236.     if ref>0 then do
  237.         'READTEXT('ref')'
  238.         j=right(result,length(result)-length(reference))
  239.         if j~="" then do
  240.         val.j=1
  241.         end
  242.     end
  243.     obj=obj+1
  244.     end
  245.     return
  246. end
  247.  
  248. syntax:
  249. erreur=RC
  250. 'MESSAGE("Script AddRefs"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  251. exit
  252.  
  253. error:
  254. 'MESSAGE("Script AddRefs"+CHR(10)+"Error in line 'SIGL'")'
  255. exit
  256.